home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 45 (1996-03)(MegaDisc Digital Publishing)(AU)(Disk 1 of 2)[WB].zip / MegaDisc 45 (1996-03)(MegaDisc Digital Publishing)(AU)(Disk 1 of 2)[WB].adf / Programs / Ripple / Ripple0MD.e / Ripple0MD.e
Text File  |  1996-02-15  |  2KB  |  85 lines
  1.  
  2. /*
  3.  *  R I P P L E 0
  4.  *
  5.  *  Plot a semirandom symmetrical design.
  6.  *  Uses a backdrop window in a custom screen.
  7.  *
  8.  *  Written by M. Stapleton of Graphic Bits © 1996
  9.  *  My first E program!
  10.  *
  11.  *  Feb 9 1996
  12.  *
  13.  */
  14.  
  15. OPT OSVERSION=33
  16.  
  17.  
  18. MODULE 'intuition/intuition', 'intuition/screens',
  19.     'graphics/gfxbase', 'graphics/view'
  20.  
  21. CONST MI=100
  22.  
  23. PROC main()
  24.     DEF i, j, x, y, p, mx, my, rx, ry, depth, mp, sp,
  25.         loc[3]:ARRAY, hic[3]:ARRAY, cc[3]:ARRAY,
  26.         screen, window, gbase : gfxbase
  27.  
  28.     /* Get max depth */
  29.     depth := IF KickVersion(39) THEN 8 ELSE 4
  30.  
  31.     /* Get normal screen size & max depth */
  32.     gbase := gfxbase
  33.     mx := gbase.normaldisplaycolumns
  34.     my := gbase.normaldisplayrows * 2
  35.     mp := Shl(1,depth) - 1                      ->Max pen
  36.  
  37.     /* Colour scaling factor */
  38.     sp := mx * my / mp / 2
  39.  
  40.     /* Base colours for range */
  41.     loc := [255, 136, 0]:CHAR
  42.     hic := [0, 0, 187]:CHAR
  43.  
  44.     /* Open a full-size Hires Interlace screen */
  45.     IF screen := OpenS(mx, my, depth, V_LACE OR V_HIRES, NIL,
  46.         [SA_QUIET,TRUE,  0])
  47.  
  48.         /* Set palette */
  49.         SetColour(screen, 0,  0, 0, 0)      ->Black background
  50.         FOR i := 1 TO mp
  51.             FOR j := 0 TO 2
  52.                 cc[j] := (hic[j] - loc[j]) * (i-1) / (mp-1) + loc[j]
  53.             ENDFOR
  54.             SetColour(screen, i,  cc[0], cc[1], cc[2])
  55.         ENDFOR
  56.  
  57.         /* Open a backdrop window */
  58.         IF window := OpenW(0, 0, mx, my,
  59.             IDCMP_MOUSEBUTTONS,
  60.             WFLG_BACKDROP OR WFLG_BORDERLESS OR
  61.             WFLG_NOCAREREFRESH OR WFLG_RMBTRAP,
  62.             NIL, screen, $f, NIL)
  63.  
  64.             REPEAT
  65.                 FOR i := 0 TO MI
  66.                     /* Semirandom, symmetrical design */
  67.                     x := Rnd(mx);   y := Rnd(my)
  68.                     rx := mx - x;   ry := my - y
  69.  
  70.                     /* Determine pen from radius */
  71.                     p := 1 + Mod((x*x) + (y*y) / sp, mp)
  72.  
  73.                     /* Four way symmetry */
  74.                     Plot(x, y, p)
  75.                     Plot(rx, y, p)
  76.                     Plot(rx, ry, p)
  77.                     Plot(x, ry, p)
  78.                 ENDFOR
  79.             UNTIL LeftMouse(window)
  80.             CloseW(window)
  81.         ENDIF
  82.     CloseS(screen)
  83.     ENDIF
  84. ENDPROC
  85.